perm filename BIGMSS.F4[MSS,LCS] blob sn#155850 filedate 1975-04-16 generic text, type T, neo UTF8
00100	C  TO PUT .DAT MSS FILES TOGETHER AND TAKE APART.  LOAD WITH MSFAIL
00200		DIMENSION SV(127)
00400		COMMON /POSI/STFF(8)
00600		1 ,V(78),ISCR,LCNT,LIST(200)
00800		1 ,RN(2200)
01000		1 ,RSTFAC(8),PWDS(250)
01200		EQUIVALENCE (SV,RN)
01400		TYPE 1
01600	1	FORMAT(' PACK, UNPACK? -- '$)
01800		ACCEPT 2,K
02000	2	FORMAT(A1)
02200		IF(K.NE.'U')GO TO 3
02400	6	TYPE 20
02600		ACCEPT 21,NAME
02650		NN=1
02700		TYPE 27
02800	27	FORMAT(' GET WHICH FILE?  '$)
02900		ACCEPT 21,NZ,N
02950		IF(NZ.EQ.'ALL')NZ=' '
02975		IF(NZ.EQ.' ')N=999
03000	C  BLANK GETS ALL
03400		GO TO 4
03600	
03800	3	TYPE 26
04000	26	FORMAT(' TYPE OUTPUT FILE NAME -- '$)
04200		ACCEPT 21,NOUT
04400		REWIND 1
04500		IF(LOOKD(NOUT).GE.0)GO TO 100
04510		TYPE 101
04520	101	FORMAT(' WRITE OVER THIS FILE?  '$)
04530		ACCEPT 2,L
04540		IF(L.EQ.'N')GO TO 3
04600	100	CALL OFILE(1,NOUT)
04800	25	TYPE 20
05000	20	FORMAT(' TYPE FILE NAME --  '$)
05200		ACCEPT  21,NAME,N
05210		NMZ=NAME
05400		IF(NAME.EQ.' ')GO TO 30
05600		NN=1
05800		IF(N.EQ.0)N=999
06000	C  WILL READ ALL IT CAN FIND.
06200	21	FORMAT(A5,I)
06400	23	IF(LOOKD(NAME))GO TO 22
06600	C  JUMP IF IT FOUND IT.
06800		TYPE 24
07000	24	FORMAT(' FILE NOT FOUND'/)
07200		GO TO 25
07400	
07600	22	IF(LOOKD(NAME).GE.0)GO TO 25
07800		NM=NAME
08000	4	REWIND 21
08200		CALL IFILE(21,NAME)
08300	7	NMX=NAME
08400	9	READ(21,END=30)ITEM,I
08600		1,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,(V(L),L=1,ISCR),
08800		1 LCNT,(LIST(L),L=1,LCNT),RSTFAC,STFF,NAME
08900		IF(K.EQ.'U')GO TO 310
09000		READ(21,END=31)RSTFAC,STFF
09005		GO TO 31
09010	310	READ(21,END=31)RSTFAC,STFF,NAME
09110		IF(NZ.EQ.' ')GO TO 311
09160		IF(NZ.NE.NAME)GO TO 9
09185	C  SEARCH FOR A PARTICULAR NAME.
09210	311	TYPE 10,NAME
09220		IF(LOOKD(NAME).GE.0)GO TO 102
09230		TYPE 101
09240		ACCEPT 2,L
09250		IF(L.NE.'N')GO TO 102
09260	C  IF 'NO' GO BACK FOR NEXT FILE
09270		TYPE 103
09280		ACCEPT 21,NAME
09290		IF(NAME.EQ.' ')GO TO 9
09300	103	FORMAT(' TYPE NEW NAME -- '$)
09400	102	REWIND 1
09600		CALL OFILE(1,NAME)
09725		GO TO 11
09750	10	FORMAT(1XA5)
09775	31	TYPE 10,NMX
09787	11	ISCR=1
09793		LIST(1)=0
09796	C CLEARS MOTIVE LIST
09800	 	WRITE(1)ITEM,I,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,V(1),
10200		1 ISCR,LIST(1),RSTFAC,STFF,NM,SV
10400		WRITE(1)RSTFAC,STFF,NM,L,L,L
10600		IF(K.EQ.'U')GO TO 8   
10800		IF(NN.LT.N)GO TO  5
11000		GO TO 25
11400	
11600	5	NN=NN+1
11700		NAME=NMX
11800		NAME=NAME+2
12000	C  GOES UP THE ALPHABET
12010		IF(LOOKD(NAME))GO TO 999
12110		NAME=NMZ+256
12155		NMZ=NAME
12200	999	IF(K.NE.'U')GO TO 22
12300	8	END FILE 1
12500		NN=NN+1
12525		NZ=' '
12550		IF(NN.LE.N)GO TO 9
12600	30	END